Transactor

home *** CD-ROM | disk | FTP | other *** search

/ Transactor / Transactor_17_1987_Transactor_Publishing.d64 / textscan cp_m < prev next >

Wrap

Text File | 2023-02-26 | 21KB | 647 lines

;------------------------------------------------- ; "TEXT SCAN" FOR CP/M+ ON THE C128 ; Aubrey Stanley, Nov 1986 ;------------------------------------------------- ; maclib z80 ;Z80 macro library org 100h ;Start address ; CP/M Functions boot equ 0 ;Warm start bdos equ 5 ;CP/M Function Vector dciof equ 6 ;Direct console printf equ 9 ;Print string coninf equ 10 ;Read console buffer openf equ 15 ;Open file closef equ 16 ;Close file readf equ 20 ;Read sequential sdmaf equ 26 ;Set DMA address msecf equ 44 ;Multi-sector I/O sconm equ 109 ;Set console mode sdlmf equ 110 ;Set output delimiter ; ; File Control Block fcb equ 5ch fcbex equ fcb+12 fcbcr equ fcb+32 ; ; Console Buffer for Find string dmabuf equ 80h mx equ dmabuf ;Max chars nc equ mx+1 ;Num chars rchar equ nc+1 ;Char string ; ; Character equates rawinp equ 0ah ;Raw input mode eomc equ 1ah ;End of file cr equ 0dh ;Carriage ret lf equ 0ah ;Line feed tabc equ 09h ;Tab bell equ 07h ; ; Decoded values for C128 keys period equ 24 ; . key plus equ 28 ; + minus equ 27 ; - endof equ 29 ; Cur down bgnof equ 30 ; Cur up nscrol equ 32 ; No scroll number equ 31 ; 0-9 alt equ 33 ; Alt tab equ 26 ; Tab enter equ 25 ; Enter help equ 34 ; Help ; ; Offsets for variables on the IX register scroly equ 0 ; Scroll mode stop equ 1 ; Stop scroll dir equ 2 ; Current direction lmit equ 3 ; Limit reached lnum equ 4 ; Line numbering on double equ 5 ; Double 0-9 values cnt1 equ 6 ; Current number for scroll cnt2 equ 7 ; Number of lines scrolled count equ 8 ; General purpose ; ;-------------------------------------------- chksum: ;CHECKSUMS your code - ;Can be DELETED when all is well lxi b,progend-start ;Count to check lxiy start ;From sstart lxi h,9170h ;Checksum excess mvi d,0 chks: ldy e,0 ;Check loop dad d ;...adds bytes inxiy dcx b mov a,b ora c jrnz chks mov a,l ;Should ora h ;...be 0 jrz start ;Good code mvi c,dciof ;Bad code lxi d,'?' ;...print ? call bdos ;...and ret ;...exit ;END OF CHECKSUM CODE - ;----------------------------------------------- ; start: ;Set stack and open file sspd oldsp lxi sp,stktop xra a ;Init fcb sta fcbex sta fcbcr lxi d,fcb mvi c,openf call bdos ;Open ora a jrz read lxi d,opnerr ;Bad open mvi c,printf call bdos finis: ;restore stack and exit lspd oldsp ret ; read: ;read file lxix pflags ;Print flags base lxi h,0 ;Init sector count shld line mvi e,128 ;128 sectors to read stx e,lmit ;Save for rloop mvi c,msecf call bdos ;Set multisectors mvix 3,count ;3 reads lxi d,fbegin ;Start of read area call rloop ;Read up to 48K ora a ;Check end of file jrnz close ;...yes! push d ;Save dma address mvi e,48 ;Read 48 more sectors stx e,lmit ;Save for rloop mvi c,msecf call bdos ;Set multisectors pop d mvix 1,count ;1 read call rloop ;Read up to 6K more close: lxi d,fcb mvi c,closef ;Close call bdos ; bytes: ;Calculate total chars lhld line ;Total sectors mvi b,7 ;Count byte10: dad h ;Double value dcr b ;...7 times jrnz byte10 lxi d,fbegin ;Start dad d ;End mvi a,eomc eom: dcx h ;Find last char cmp m jrz eom mov a,m inx h cpi lf jrz eom10 mvi m,cr ;CR/LF at end inx h mvi m,lf inx h eom10: mvi m,eomc ;End of file char shld fend ;End of file address inx h shld linbuf ;Line buffer address jmp print ;output routine ; rloop: ;Reads multisectors and keeps count push d ;Save dma address mvi c,sdmaf call bdos ;Set dma address lxi d,fcb mvi c,readf call bdos ;Read multisectors cpi 2 ;Bad error? jrc rlp5 ;...no! ; badr: ;Error on read lxi d,rderr mvi c,printf call bdos lxi d,fcb mvi c,closef ;Close call bdos jmp finis ; rlp5: ora a ;More to read? jrnz rlp6 ;No! ldx h,lmit ;Store full count rlp6: mov e,h ;# sectors read mvi d,0 ; rlp10: ;sum total sectors so far lhld line ;Current count dad d ;Add in sectors read shld line pop d cpi 1 ;End of file? rz ;Yes! mvi a,64 ;Next dma address add d ;...up 128 sectors mov d,a ;...or 16K in DE dcrx count ;Any more reads? jrnz rloop ;Yes, continue reading xra a ;more bytes status ret ; print: ;Initialize for printing file mvi a,40 ;40 char buffer sta mx ;...for Find mvix nscrol,stop ;To scroll mvix 0,scroly ;Not continuous mvix 0,double ;dont double count mvix plus,dir ;Direction mvix 0,lnum ;No line numbers mvix 24,cnt1 ;24 lines a time lxi h,fbegin-2 ;Store beginning mvi m,eomc ;...of file inx h ;...preamble mvi m,lf inx h shld line ;Address of lxi h,1 ;...first line shld lino ;...line number pr10: call getln ;Get next line jrnz pr10 ;...until limit lhld lino ;Store last line's shld endln ;...line number lxi h,fbegin ;Start with shld line ;...first line lxi h,1 shld lino mvix 0,lmit ;Clear limit mvi e,lf ;Set LF mvi c,sdlmf ;...delimiter call bdos ;...for output lxi d,rawinp ;Console mode mvi c,sconm ;...set call bdos call clear ;Clear screen ; ploop: ;Print loop controls output to screen ldx a,cnt1 ;Lines to output stx a,cnt2 plp10: call getkey ;Conditions output lxi d,sfwd ;Forward ldx a,dir ;...direction ora a jrnz plp12 lxi d,sbak ;Backward plp12: mvi c,printf ;Outp insert or delete call bdos ;...line string ldx a,lnum ;Check line ora a ;...numbering cnz numout ;...on and output num call buflin ;Expand line in buffer lded linbuf ;Line buffer address mvi c,printf ;Output call bdos ;...line plp18: call getln ;Get next line pointer ldx a,lmit ;Check file limit ora a ;...reached jrz plp20 ;No! mvix 0,stop ;Stop output jr plp10 plp20: dcrx cnt2 ;Count down jrnz plp10 mvix 0,stop ;Count expired..stop jr ploop ; Actions key input...loops until Stop cleared getkey: ;input routine call kscan ;Scan 128 keys ora a jrz gkg60 ;No press cpi number ;Line Feed? jrnz gk20 xorx lnum ;Toggle line stx a,lnum ;...number flag jr gk48 ; gk20: cpi tab ;Tab? jrnz gk22 call upln ;Advance line jr gk48 ;...position gk22: cpi alt ;Alt? jrnz gk30 xorx double ;Toggle stx a,double ;...double flag call sound ;Sound bell jr gkg60 ; gk30: cpi enter ;Enter? jrz gk48 ;Yes! jrnc gk36 ;Not a number key! cpi 11 ;Period key..24 lines? jrnc gk34 ;Yes! mov b,a ldx a,double ;Double flag? ora a mov a,b jrz gk34 add a ;Double 1-(1)0 gk34: stx a,cnt1 ;New output count jr gk48 gk36: cpi nscrol ;No Scroll? jrnz gk40 xorx scroly ;Toggle stx a,scroly ;...scroll flag gkg60: jr gk60 ; gk40: cpi bgnof ;Curs Up? jrnz gk44 mvix plus,dir ;Scroll up direction lxi h,fbegin ;First line shld line ;...address lxi h,1 ;Line 1 jr gk46 gk44: cpi endof ;Curs Down? jrnz gk50 mvix 0,dir ;Scroll down dir lhld fend ;End of file address lxi b,2000 ;Max length of line call upm02 ;Go back 1 to last line lhld endln ;Last line number gk46: shld lino ;Line number gk47: call clear ;Clear screen mvix 0,lmit ;Clear limit condition gk48: ldx a,cnt1 ;New count stx a,cnt2 jr gk64 ; gk50: cpi help ;Help? jrnz gk52 call find ;Find input string jrnz gk47 mvix 1,cnt2 ;1 line outut mvix 0,scroly ;Clear scroll flag jr gk64 gk52: cpi minus ;Minus? jrnz gk54 ;No, must be Plus! xra a gk54: ldx b,dir ;Update direction stx a,dir cmp b jrz gk62 jr gk47 ;Direction changed ; gk60: ldx a,scroly ;Check scroll on ora a jrz gk70 ;No! ; gk62: mvix 1,cnt2 ;Feed ongoing count gk64: ldx a,lmit ;Check limit reached ora a jrnz gk70 ;Yes! mvix nscrol,stop ;Clear stop condition ; gk70: ldx a,stop ;If stop condition ora a ;...then jz getkey ;...loop until clear ret ; upln: ;Advance 24 lines ldx a,lmit ;Dont advance ora a ;...if rnz ;...on limit mvix 25,count upln1: dcrx count cnz getln ;Get next line jrnz upln1 ;Not on limit mvix 0,lmit ;Clear limit if set to ret ;...dsp 1st/last line ; getln: ;Get next line lhld line ;Line address lxi b,2000 ;Max length ldx a,dir ;Check direction ora a jrz upmin ; uplus: mvi a,lf ;Search char lxi d,1 ccir ;Find next line mvi a,eomc ;Reached limit cmp m jrnz upm10 ;No! upp10: mvix 1,lmit ;Return limit ret ;...set ; upmin: lda lino+1 ;Check ora a ;...if jrnz upm02 ;...on lda lino ;...first cpi 1 ;...line jrz upp10 ;Yes! upm02: dcx h dcx h mvi a,lf lxi d,-1 ccdr ;Find previous line inx h inx h upm10: shld line ;New line address mvix 0,lmit ;Clear limit lhld lino ;Update dad d ;...line shld lino ;...number mvi a,1 ;Return ora a ;...good ret ;condition ; ; numout: ;Output line number lxiy linasc ;Base for string lhld lino ;Line number lxi d,-10000 ;Ten thousands call toasc ;Convert to ASCII lxi d,-1000 ;Thousands call toasc lxi d,-100 ;Hundreds call toasc lxi d,-10 ;Tens call toasc mov a,l ;0 - 9 adi '0' sty a,0 lxi d,linasc mvi c,printf ;Print string call bdos ret ; toasc: mvi c,'0'-1 toas1: inr c dad d jc toas1 mov a,d cma mov d,a mov a,e cma mov e,a inx d dad d sty c,0 inxiy ret ; buflin: ;Prepare line for output lbcd line ;Current line address lhld linbuf ;Line buffer address bufl10: mvix 8,count ;Tab count bufl12: ldax b inx b cpi 20h ;Trap control char jrnc bufl16 ;Not one cpi cr ;Carriage return? jrz bufl16 cpi lf ;Line feed? jrz bufl16 cpi tabc ;Check if tab jrnz bufl15 ;No! bufl14: mvi m,' ' ;Expand tab inx h dcrx count jrnz bufl14 jr bufl10 bufl15: mvi m,'^' ;Convert control char inx h ;...to two chars ori 40h ;...for display bufl16: mov m,a ;Normal char inx h cpi lf ;Line feed rz ;...ends line dcrx count jrz bufl10 jr bufl12 ; find: ;Search Input String function call kscan ;loop until lda ktable ;...help ora a ;...key is jrnz find ;...released call revrse ;direction call getln ;adjust line params call revrse lxi d,cbot ;Bottom line ldx a,dir ;Check direction ora a jrnz find02 lxi d,ctop ;Top line find02: mvi c,printf ;Clear line call bdos lxi d,dmabuf ;Buffer for input mvi c,coninf ;Get input string call bdos lda nc ;Check char count ora a rz ;Empty string stx a,count lhld lino ;Save shld tempn ;...current line lhld line ;...params in case shld templ ;...no match find10: lbcd line ;Begin search loop find12: mvi e,0 lxi h,rchar find14: ldax b cmp m inx h inx b jrnz find16 inr e mov a,e cmpx count jrnz find14 jr sound ;String found find16: cpi lf jrnz find12 call getln jrnz find10 find20: lhld templ ;Limit reached shld line ;...so lhld tempn ;...restore shld lino ;...original line mvix 0,lmit ;Clear limit ret ; sound: ;Bell mvi c,dciof lxi d,bell call bdos mvi a,1 ora a ret ; revrse: ;Reverse current direction mvi a,plus xorx dir stx a,dir ret ; clear: ;Clear Screen lxi d,clr mvi c,printf call bdos ret ; kscan: ;Scan C128 Keys di lxi h,ktable ;Key press/change table lxi b,0dc00h ;Key matrix drives for mvi d,0ffh ;...C64 keys are outp d ;...are disabled mvi d,0feh ;Drive one row mvi e,3 ;...of three kscn2: lxi b,0d02fh ;Drives for outp d ;...C128 keys lxi b,0dc01h ;To read row kscn3: inp a ;Read keys push h ;A little delay inp h ;...helps along the way! cmp h ;Debounce pop h jrnz kscn3 ;Check again cma ;Make 1's of presses mov b,m ;Previous keys mov m,a ;New keys xra b ;...gives changes ana m ;...and pressed changes inx h mov m,a ;Save pressed changes inx h ;Now for rlcr d ;...next row dcr e jrnz kscn2 ; kchng: ;Process Changes ei lxi h,ktable+2 ;First mov a,m ;...check ani 1 ;...ESC? jrz kchg1 call clear ;Clear screen jmp finis ;...and exit kchg1: mov a,m ani 06h ;+/- presses? inx h jrz kchg2 ora m ;Force a change mov m,a kchg2: inx h inx h mvi c,3 ;Count kchg3: mov a,m ;Pressed changes cma inr a ana m ;Extract one change jnz kchg10 ;Found one dcx h ;Goto next row dcx h dcr c jrnz kchg3 ret ;No changes found ; kchg10: ;Decode Change lxi h,dtable ;Key Decode table lxi d,8 kchg12: dcr e add a jrnc kchg12 dad d mvi e,8 kchg14: dcr c jrz kchg20 dad d jr kchg14 kchg20: mov a,m ;Decoded value ret ; dtable: ;Key Decode Table db help,08,05,tab,02,04,07,01 db 00,plus,minus,number,enter,06,09,03 db alt,10,24,bgnof,endof,00,00,nscrol ; ktable: ;Key Press/Change Table: rows 1-3 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 db 0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0 ; opnerr: db cr,lf,'no file$' rderr: db cr,lf,'bad read error$' ; sfwd: db 1bh,3dh,20h,20h,1bh,52h,1bh,3dh,37h,20h,0ah sbak: db 1bh,3dh,20h,20h,1bh,45h,0ah ctop: db 1bh,3dh,20h,20h,1bh,54h,0ah cbot: db 1bh,3dh,37h,20h,1bh,54h,0ah clr: db 1ah,0ah linasc: db '00000: ',0ah ; progend equ $ ;Used for checksum on code ; fend: ds 2 ;File end address linbuf: ds 2 ;Line buffer address line: ds 2 ;Current line address lino: ds 2 ;Current line number endln: ds 2 ;Last line number templ: ds 2 ;Work area tempn: ds 2 ;Work area pflags: ds 10 ;IX register variables oldsp: ds 2 ;Saved stack ds 128 ;Program stack stktop equ $ ; fbegin equ 800h ;Text file loads here ; end